home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol260 / clock.arc / CLOCK.IBM
Encoding:
Text File  |  1986-04-07  |  12.3 KB  |  335 lines
  1. program test_clock_IBM;
  2.  
  3. (******************************************************************)
  4. (*                                                                *)
  5. (*   CLOCK.IBM  Ver 1.0  April 7,1986   by  Clarence C. Rudd      *)
  6. (*                                                                *)
  7. (*   Clock.LIB is a file that contains several clock routines     *)
  8. (*   for use with IBM type computer systems.                      *)
  9. (*                                                                *)
  10. (*   To use this libaray load it into your file and then delete   *)
  11. (*   the routines not needed.                                     *)
  12. (*                                                                *)
  13. (*   NOTE: All of the user routines in this libaray are in the    *)
  14. (*   form of function calls. Example of use would be:             *)
  15. (*                                                                *)
  16. (*        String_variable := Date_1 + '  ' + Time_12;             *)
  17. (*                                                                *)
  18. (*    The String_variable would now contain the date & time       *)
  19. (*        i.e. 04/07/86  1:31:15 PM                               *)
  20. (*                                                                *)
  21. (******************************************************************)
  22.  
  23.  
  24. (******************************************************************)
  25. (*                                                                *)
  26. (*    The following declarations and constants plus the           *)
  27. (*    Procedure Read_Clock must be in your program to use         *)
  28. (*    any of the time & date Functions.                           *)
  29.  
  30. type
  31.   str8  = string[8];
  32.   str11 = string[11];
  33.   str17 = string[17];
  34.   str28 = string[28];
  35.   str30 = string[30];
  36.  
  37.  
  38.  
  39. (*  These are the main procedure called by all of the time &      *)
  40. (*  date Functions . They read the info from the IBM system clock *)
  41. (*  and converts it to bytes and store it in the following passed *)
  42. (*  variables in the form of:                                     *)
  43. (*                                                                *)
  44. (*              Get_Date      month in range 1(Jan)..12(Dec)      *)
  45. (*                            day in range 1..length of month     *)
  46. (*        (calculated)        and week_day in 1(Sun)..7(Sat)      *)
  47. (*                                                                *)
  48. (*              Get_Time      hour in 0..23 (24-hr clock)         *)
  49. (*                            minute and second in 0..59          *)
  50. (*                                                                *)
  51. (*  NOTE: the variables are of type Byte to save space.           *)
  52.  
  53. {.PA}
  54. function Get_Day_of_Week(month, day : byte; year : integer): byte;
  55.   var
  56.     Leap_Year : boolean;
  57.     DayNum, yy, cc : integer;
  58.  
  59. begin
  60.   yy := year mod 100; { get last 2 digits of year }
  61.   cc := year div 100; { get the century           }
  62.  
  63.   DayNum := yy;      {load DayNum with year      }
  64.   DayNum := DayNum + (yy DIV 4); { add 1/4 of year, dropping remainder }
  65.   DayNum := DayNum + day; {add day of month}
  66.   Leap_Year := (yy MOD 4) = 0; { set true if a leap year }
  67.   case month of    { add value for month }
  68.     1 : if not Leap_Year then DayNum := DayNum + 1;
  69.     2 : if Leap_Year
  70.           then DayNum := DayNum +3
  71.           else DayNum := DayNum + 4;
  72.     3 : DayNum := DayNum + 4;
  73.     4 : DayNum := DayNum + 0;
  74.     5 : DayNum := DayNum + 2;
  75.     6 : DayNum := DayNum + 5;
  76.     7 : DayNum := DayNum + 0;
  77.     8 : DayNum := DayNum + 3;
  78.     9 : DayNum := DayNum + 6;
  79.    10 : DayNum := DayNum + 1;
  80.    11 : DayNum := DayNum + 4;
  81.    12 : DayNum := DayNum + 6;
  82.   end; { of case month }
  83.  
  84.  case cc of        { add value for century }
  85.     17 : DayNum := DayNum + 4;
  86.     18 : DayNum := DayNum + 2;
  87.     19 : DayNum := DayNum + 0;
  88.     20 : DayNum := DayNum + 6;
  89.  end; { of case cc }
  90.  
  91. (*   determine day of week by dividing day by 7, remainder = day of week *)
  92. (*   as follows:                                                         *)
  93. (*        1 = SUNDAY                                                     *)
  94. (*        2 = MONDAY                                                     *)
  95. (*        3 = TUESDAY                                                    *)
  96. (*        4 = WEDNESDAY                                                  *)
  97. (*        5 = THURSDAY                                                   *)
  98. (*        6 = FRIDAY                                                     *)
  99. (*        0 = SATURDAY   ( GETS ADJUSTED TO A VALUE OF 7)                *)
  100. (*                                                                       *)
  101.    DayNum := DayNum MOD 7;
  102.    if DayNum = 0 then DayNum := 7;
  103.    Get_Day_of_Week := DayNum;
  104.  end; { of function Get_Day_of_Week }
  105.  
  106. {.PA}
  107. procedure Get_Date(var month, day : byte; var year : integer);
  108.   type
  109.     Regpack = record
  110.       case integer of
  111.         1 : (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : integer);
  112.         2 : (AL, AH, BL, BH, CL, CH, DL, DH            : byte);
  113.     end;
  114.   var
  115.     recpack:       regpack;                {record for MsDos call}
  116.  
  117.   begin
  118.     recpack.ah := $2a ;            { MsDos get date code }
  119.     MsDos(recpack);                { call function }
  120.     with recpack do
  121.     begin
  122.       year := cx;                  {move from recpack to var }
  123.       day := (dx mod 256);                    { " }
  124.       month := (dx shr 8);                    { " }
  125.     end;
  126.   end;
  127.  
  128.  
  129. procedure Get_Time(var hour, min, sec : byte);
  130.   type
  131.     Regpack = record
  132.       case integer of
  133.         1 : (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags : integer);
  134.         2 : (AL, AH, BL, BH, CL, CH, DL, DH            : byte);
  135.     end;
  136.  
  137.   var
  138.     recpack: regpack;   {assign record}
  139.  
  140.   begin
  141.     recpack.ah := $2c;        {initialize correct registers}
  142.     intr($21,recpack);        {call interrupt}
  143.     with recpack do
  144.     begin
  145.       hour := (cx shr 8);     {convert and move to byte vars}
  146.       min := (cx mod 256);             { " }
  147.       sec := (dx shr 8);               { " }
  148.     end;
  149.   end;
  150.  
  151.  
  152. (*                                                                *)
  153. (*                  End of required procedure                     *)
  154. (******************************************************************)
  155. {.PA}
  156. (******************************************************************)
  157. (*   Date_1  returns 8-character srting i.e. (04/07/86)           *)
  158. (*                                                                *)
  159.  
  160. function Date_1: str8;
  161.  
  162.   var
  163.     tempm, tempd, tempy : string[2];
  164.     month, day : byte;
  165.     year : integer;
  166.  
  167.   begin
  168.     Get_Date(month, day, year);
  169.     str(month:1,tempm);
  170.     if length(tempm) = 1 then tempm := '0' + tempm; {add leading 0 ?}
  171.     str(day:1,tempd);
  172.     if length(tempd) = 1 then tempd := '0' + tempd; {add leading 0 ?}
  173.     str((year mod 100):1,tempy);
  174.     Date_1 := tempm + '/' + tempd + '/' + tempy;
  175.   end;
  176.  
  177. (*                                                                *)
  178. (*                 End of Function Date_1                         *)
  179. (******************************************************************)
  180. {.PA}
  181. (******************************************************************)
  182. (*   Date_2 returns 17-characater string i.e. (Mon  Apr 7, 1986)  *)
  183. (*                                                                *)
  184.  
  185. function Date_2: str17;
  186.  
  187.   const
  188.     week_days:   array [1..7] of string[3] =
  189.                  ('Sun','Mon','Tue','Wen','Thu','Fri','Sat');
  190.     months:      array [1..12] of string[3] =
  191.                  ('Jan','Feb','Mar','Apr','May','Jun',
  192.                   'Jul','Aug','Sep','Oct','Nov','Dec');
  193.  
  194.   var
  195.     tempd : string[2];
  196.     tempy : string[4];
  197.     month, day, week_day : byte;
  198.     year : integer;
  199.  
  200.   begin
  201.     Get_Date(month, day, year);
  202.     week_day := Get_Day_of_Week(month,day,year);
  203.     str(day:1,tempd);
  204.     str(year:1,tempy);
  205.  
  206.   {delete the this line if you want leading zero on day of month
  207.     if length(tempd) = 1 then tempd := '0' + tempd; {add leading 0 ?}
  208.  
  209.     Date_2 := week_days[week_day] + '  ' + months[month]  + ' '
  210.                                    + tempd + ', ' + tempy;
  211.   end;
  212.  
  213. (*                                                                *)
  214. (*                  End of Function Date_2                        *)
  215. (******************************************************************)
  216. {.PA}
  217. (******************************************************************)
  218. (*   Date_3 returns a string with a max length of 28 characters   *)
  219. (*   i.e. (Monday  April 7, 1986)                                 *)
  220. (*        (Saturday  December 27, 1986)                           *)
  221. (*                                                                *)
  222.  
  223. function Date_3: str28;
  224.  
  225.   const
  226.     week_days:   array [1..7] of string[9] =
  227.                  ('Sunday','Monday','Tuesday','Wendesday','Thursday',
  228.                   'Friday','Saturday');
  229.     months:      array [1..12] of string[9] =
  230.                  ('Janurary','February','March','April','May','June',
  231.                   'July','August','September','October','November','December');
  232.  
  233.   var
  234.     tempd : string[2];
  235.     tempy : string[4];
  236.     month, day, week_day, hour, min, sec : byte;
  237.     year : integer;
  238.  
  239.   begin
  240.     Get_Date(month, day, year);
  241.     str(day:1,tempd);
  242.     str(year:1,tempy);
  243.     week_day := Get_Day_of_Week(month,day,year);
  244.  
  245.   {delete the this line if you want leading zero on day of month
  246.     if length(tempd) = 1 then tempd := '0' + tempd; {add leading 0 ?}
  247.  
  248.     Date_3 := week_days[week_day] + '  ' + months[month]  + ' ' +
  249.                                           tempd + ', '+ tempy;
  250.   end;
  251.  
  252. (*                                                                *)
  253. (*                     End of Function Date_3                     *)
  254. (******************************************************************)
  255. {.PA}
  256. (******************************************************************)
  257. (*                START OF THE TIME FUNCTIONS                     *)
  258. (******************************************************************)
  259. (*   Time_12 returns 11-character string i.e. (12:01:00 AM)       *)
  260. (*                                                                *)
  261.  
  262. function Time_12: str11;
  263.  
  264.   var
  265.     pm : boolean;
  266.     temp : string[11];
  267.     temps, tempm, temph: string[2];
  268.     hour, min, sec : byte;
  269.  
  270.   begin
  271.     Get_Time(hour, min, sec);
  272.     str(sec:1,temps);
  273.     str(min:1,tempm);
  274.     if length(temps) = 1 then temps := '0' + temps;
  275.     if length(tempm) = 1 then tempm := '0' + tempm;
  276.  
  277.     if hour >= 12 then begin {if after 12 PM convert from military time}
  278.       pm := true;
  279.       if hour > 12 then hour := hour - 12;
  280.     end
  281.     else begin
  282.       pm := false;
  283.       if hour = 0 then hour := 12;   {if 12 AM}
  284.     end;
  285.  
  286.     str(hour:2,temph);
  287.     temp :=  temph + ':' + tempm + ':' + temps;
  288.  
  289.     if pm then temp := temp + ' PM'
  290.     else temp := temp + ' AM';
  291.     Time_12 := temp;
  292.   end;
  293.  
  294. (*                                                                *)
  295. (*                   End of Function Time_12                      *)
  296. (******************************************************************)
  297. {.PA}
  298. (******************************************************************)
  299. (*   Time_24 returns  8-character string i.e. (23:01:00)          *)
  300. (*                                                                *)
  301.  
  302. function Time_24: str8;
  303.  
  304.   var
  305.     temp : string[11];
  306.     temps, tempm, temph: string[2];
  307.     hour, min, sec : byte;
  308.  
  309.   begin
  310.     Get_Time(hour, min, sec);
  311.     str(sec:1,temps);
  312.     str(min:1,tempm);
  313.     str(hour:1,temph);
  314.     if length(temps) = 1 then temps := '0' + temps;
  315.     if length(tempm) = 1 then tempm := '0' + tempm;
  316.     if length(temph) = 1 then temph := '0' + temph;
  317.  
  318.     Time_24 :=  temph + ':' + tempm + ':' + temps;
  319.   end;
  320.  
  321. (*                                                                *)
  322. (*                   End of Function Time_24                      *)
  323. (******************************************************************)
  324. {.PA}
  325.  
  326.  
  327.   begin {of main program test_clock_lib }
  328.     writeln('This is the output of Date_1 ',Date_1);
  329.     writeln('This is the output of Date_2 ',Date_2);
  330.     writeln('This is the output of Date_3 ',Date_3);
  331.     writeln('This is the output of Time_12 ',Time_12);
  332.     writeln('This is the output of Time_24 ',Time_24);
  333.   end.  {of program test_clock_lib }
  334.  
  335.